home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CU Amiga Super CD-ROM 11
/
CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso
/
cucd
/
programming
/
oberonv4
/
system1
/
exprbessel.mod
(
.txt
)
< prev
next >
Wrap
Oberon Text
|
1996-01-09
|
5KB
|
112 lines
Syntax10.Scn.Fnt
Syntax10i.Scn.Fnt
StampElems
Alloc
7 Mar 95
Syntax10b.Scn.Fnt
MODULE ExprBessel; (* ww
IMPORT
Files, Fonts, Expressions, ExprViews, ExprStd;
TYPE
BesselFunction* = POINTER TO RECORD(Expressions.ExpressionDesc)
name-: CHAR;
index-, argument-: Expressions.Expression
END;
PROCEDURE Min(x, y: LONGINT): LONGINT;
BEGIN IF x < y THEN RETURN x ELSE RETURN y END
END Min;
PROCEDURE Max(x, y: LONGINT): LONGINT;
BEGIN IF x < y THEN RETURN y ELSE RETURN x END
END Max;
PROCEDURE Draw(b: ExprViews.Box; p: ExprViews.Port; x, y: LONGINT; col: INTEGER);
BEGIN p.DrawChar(b.exp(BesselFunction).name, x, y, b.fnt, col);
ExprViews.DrawDesc(b, p, x, y, col)
END Draw;
PROCEDURE Box(e: BesselFunction; port: ExprViews.Port; depth: LONGINT; fnt: Fonts.Font): ExprViews.Box;
VAR w, bot, top, lH, eH: LONGINT; b, ind, arg: ExprViews.Box; fnt1: Fonts.Font;
BEGIN
IF depth > 0 THEN NEW(b);
fnt1 := port.SmallerFont(fnt);
ind := ExprViews.ExprBox(e.index, b, 0, port, depth -1, fnt1);
arg := ExprViews.ExprBox(e.argument, b, 1, port, depth -1, fnt);
arg := ExprViews.BracketBox("(", arg, port, fnt); arg.y := 0;
IF fnt1 # fnt THEN top := arg.top; bot := arg.bot;
lH := ind.top - ind.bot; eH := top - bot;
IF lH < eH THEN ind.y := bot - ind.bot - lH DIV 2 ELSE ind.y := bot + eH DIV 2 - ind.top END;
bot := ind.y + ind.bot
ELSE ind := ExprViews.BracketBox("[", ind, port, fnt);
ind.y := 0;
bot := Min(ind.bot, arg.bot); top := Max(ind.top, arg.top)
END;
w := port.CharWidth(e.name, fnt);
ind.x := w; w := w + ind.w; ind.next := arg;
arg.x := w; w := w + arg.w;
b.desc := ind; b.w := w; b.bot := bot; b.top := top; b.fnt := fnt; b.draw := Draw
ELSE b := ExprViews.EllipsisBox(NIL, port, fnt)
END;
RETURN b
END Box;
PROCEDURE Init(e: BesselFunction);
VAR r: Expressions.Rider;
BEGIN
ASSERT((Expressions.LengthOf(e.successors) = 2) &
((e.name = "I") OR (e.name = "J") OR (e.name = "K") OR (e.name = "Y"))
Expressions.OpenRider(r, e.successors); e.index := r.exp; Expressions.Forward(r); e.argument := r.exp
END Init;
PROCEDURE Handler(e: Expressions.Expression; VAR m: Expressions.Message);
VAR self, c: BesselFunction; s: ARRAY 8 OF CHAR;
BEGIN self := e(BesselFunction);
WITH m: Expressions.IdentifyMsg DO m.mod := "ExprBessel"; m.proc := "AllocBesselFunction"
| m: Expressions.FileMsg DO
IF m.store THEN Files.Write(m.r, self.name)
ELSE Files.Read(m.r, self.name); Init(self)
END
| m: Expressions.CloneMsg DO NEW(c);
Expressions.Init(c, self.handle, self.binding, ORD(self.name), m.successors);
c.name := self.name; Init(c);
m.clone := c
| m: Expressions.TestMsg DO
m.equal := (m.with IS BesselFunction) & (m.with(BesselFunction).name = self.name)
& Expressions.EqualLists(m.with.successors, self.successors)
| m: ExprViews.GetBoxMsg DO m.box := Box(self, m.port, m.depth, m.fnt)
| m: ExprStd.ExpansionMsg DO
s := "Bessel "; s[6] := self.name;
m.exp := ExprStd.NewFunction(s, self.successors)
ELSE (* ignore *)
END
END Handler;
PROCEDURE AllocBesselFunction*;
VAR e: BesselFunction;
BEGIN NEW(e); Expressions.Alloc(e, Handler)
END AllocBesselFunction;
PROCEDURE NewBesselFunction*(name: CHAR; index, argument: Expressions.Expression): BesselFunction;
VAR e: BesselFunction; r: Expressions.Rider;
BEGIN ASSERT((name = "I") OR (name = "J") OR (name = "K") OR (name = "Y"));
NEW(e);
Expressions.OpenRider(r, Expressions.emptyList);
Expressions.Insert(r, index, 0); Expressions.Insert(r, argument, 0);
Expressions.Init(e, Handler, Expressions.AtomBind, ORD(name), Expressions.ThisList(r));
e.name := name; e.index := index; e.argument := argument;
RETURN e
END NewBesselFunction;
PROCEDURE Substitute*(VAR exp: Expressions.Expression);
VAR e: BesselFunction; name: ExprStd.Name;
BEGIN
IF (exp IS ExprStd.Function) & (Expressions.LengthOf(exp.successors) = 2) THEN
name := exp(ExprStd.Function).name;
IF (name = "BesselI") OR (name = "BesselJ") OR (name = "BesselK") OR (name = "BesselY") THEN
NEW(e); e.name := name[6];
Expressions.Init(e, Handler, Expressions.AtomBind, ORD(e.name), exp.successors);
Init(e);
exp := e
END
END
END Substitute;
PROCEDURE Install*;
BEGIN ExprStd.Register(Substitute)
END Install;
PROCEDURE Remove*;
BEGIN ExprStd.Remove(Substitute)
END Remove;
END ExprBessel.